home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2006 December / PCWDEC06.iso / Software / Trial / Paint Shop Pro XI / Data1.cab / wmdefault.tcl.0160FC08_F3D9_4869_9D41_C611C16F42D5 < prev    next >
Encoding:
Text File  |  2005-06-08  |  36.2 KB  |  1,128 lines
  1. # -*-mode: tcl; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
  2. #
  3. #
  4. #    $Id: WmDefault.tcl,v 1.1.2.10 2002/12/02 04:02:51 idiscovery Exp $
  5. #
  6. #    Description: Package for making Tk apps use the CDE/KDE/Gnome/Windows scheme
  7. #    Prefix: wm_default::
  8. #    Url: http://tix.sourceforge.net/Tixapps/
  9. #
  10. # Usage:
  11. #    It should be sufficient at the beginning of a wish app to simply:
  12. #
  13. #        package require wm_default
  14. #        wm_default::setup
  15. #        wm_default::addoptions
  16. #
  17. #     wm_default::setup takes an optional argument - the scheme if already
  18. #    known, one of: windows gnome kde1 kde2 cde kde
  19. #     wm_default::addoptions takes optional arguments - pairs of variables
  20. #    and values to override the kde settings. e.g. 
  21. #        wm_default::addoptions -background blue
  22. #
  23. # Description:
  24. #       package for making Tk apps look nice under CDE or KDE or Windows
  25. #
  26. #    The stuff below attempts to use the options database and the
  27. #    various files under ~/.dt, $DTHOME, and /usr/dt to figure out
  28. #    the user's current font and color set.  It then uses tk's
  29. #    palette routines to set sensible defaults, and then override
  30. #    some of the options to try to make them look like CDE.
  31. #
  32. #    There really *must* be an easier way to get text background
  33. #    colors and the radiobutton highlight colors out of the
  34. #    options database or winfo atom...  Unfortunately, I can't
  35. #    figure out how...
  36.  
  37. # This package is based on the cde package by D. J. Hagberg, Jr.:
  38. # dhagberg@glatmos.com
  39.  
  40. ########################################################################
  41. #
  42. #
  43.  # Copyright 1998 D. J. Hagberg, Jr. and Global Atmospherics, Inc.
  44.  #
  45.  # Permission to use, copy, modify, and distribute this software and its
  46.  # documentation for any purpose and without fee is hereby granted, provided
  47.  # that the above copyright notice appear in all copies.
  48.  # D. J. Hagberg, Jr. and Global Atmospherics, Inc. make no representations
  49.  # about the suitability of this software for any It is provided "as is"
  50.  # without express or implied warranty.  By use of this software the user
  51.  # agrees to  indemnify and hold harmless D. J. Hagberg, Jr. and Global
  52.  # Atmospherics, Inc. from any claims or liability for loss arising out
  53.  # of such use.
  54. ########################################################################
  55.  
  56. package require Tk
  57.  
  58. proc tixDetermineWM {} {
  59.     # Returns one of cde kde1 kde2 gnome windows or ""
  60.     global tcl_platform env
  61.  
  62.     set type ""
  63.     switch -exact -- $tcl_platform(os) {Windows 95} - {Windows NT} {
  64.     set type windows
  65.     } default {
  66.     # The most definitive way is to check the X atoms
  67.     # I'm not sure if we can determine this using regular Tk wm calls
  68.     # I don't want to intern these symbols if they're not there.
  69.     if {![catch {exec xlsatoms} xatoms]} {
  70.         if {[string match *GNOME_SESSION_CORBA_COOKIE* $xatoms]} {
  71.         set type gnome
  72.         } elseif {[string match *KDEChangeStyle* $xatoms]} {
  73.         set type kde1
  74.         } elseif {[string match *KDE_DESKTOP_WINDOW* $xatoms]} {
  75.         set type kde2
  76.         }
  77.         # KDE3 is treated as kde2
  78.     }
  79.     if {$type != ""} {
  80.         # drop through
  81.     } elseif {[info exists env(KDEDIR)] && [file isdir $env(KDEDIR)]} {
  82.         # one or two?
  83.         set type kde2
  84.     } elseif {[info exists env(DTHOME)] && [file isdir $env(DTHOME)]} {
  85.         set type cde
  86.     } else {
  87.         # Maybe look for other Unix window managers?
  88.         # if {[file isfile $env(HOME)/.fwm2rc]} {}
  89.         # if {[file isfile $env(HOME)/.fwmrc]} {}
  90.         # if {[file isfile $env(HOME)/.twmrc]} {}
  91.         # But twm and fwm don't color applications; mwm maybe?
  92.         # Hope someone comes up with the code for openlook :-)
  93.         return ""
  94.     }
  95.     }
  96.     return $type
  97. }
  98.  
  99. namespace eval ::wm_default {
  100.     global tcl_platform env
  101.  
  102.     if {[info commands "tix"] != ""} {set _usetix 1} {set _usetix 0}
  103.  
  104.     variable wm ""
  105.  
  106.     variable _frame_widgets {*Frame *Toplevel}
  107.     #what about tixGrid?
  108.     if {$_usetix} {
  109.     lappend _frame_widgets *TixLabelFrame *TixButtonBox *TixCObjView \
  110.         *TixListNoteBook *TixPanedWindow *TixStdButtonBox \
  111.         *TixExFileSelectBox
  112.     }
  113.     variable _menu_font_widgets {*Menu *Menubutton}
  114.     if {$_usetix} {lappend _menu_font_widgets *TixMenu}
  115.     variable _button_font_widgets {*Button}
  116.     
  117.     variable _system_font_widgets {*Label \
  118.         *Message \
  119.                 *Scale *Radiobutton *Checkbutton
  120.     }
  121.     if {$_usetix} {lappend _system_font_widgets \
  122.        *TixBalloon*message *TixLabelFrame*Label \
  123.        *TixControl*label *TixControl*Label \
  124.        *TixLabelEntry*label *TixNoteBook.nbframe \
  125.        *TixFileEntry*label *TixComboBox*label  \
  126.        *TixOptionMenu*menubutton  *TixBitmapButton*label  \
  127.        *TixMwmClient*title *TixFileSelectBox*Label
  128.     }
  129.    variable _text_type_widgets {*Canvas *Entry *Listbox *Text}
  130.    if {$_usetix} {
  131.        lappend _text_type_widgets \
  132.        *TixComboBox*Entry *TixControl*entry *TixScrolledHList*hlist \
  133.        *TixDirTree*hlist *TixDirList*hlist *TixTree*hlist \
  134.        *TixMultiList*Listbox *TixScrolledListBox*listbox  \
  135.        *TixFileEntry*Entry *TixLabelEntry*Entry \
  136.        *TixFileEntry*entry *TixLabelEntry*entry \
  137.        *TixScrolledTList*tlist  *TixScrolledText*text \
  138.        *TixHList *TixCheckList*hlist
  139.        # These arent working yet
  140.        lappend _text_type_widgets \
  141.            *TixDirTree*f1 *TixDirList*f1 \
  142.            *TixFileSelectBox*file*listbox \
  143.            *TixFileSelectBox*directory*listbox \
  144.            *TixExFileSelectBox*filelist*listbox
  145.    }
  146.  
  147.    variable _insert_type_widgets {*Entry *Text}
  148.    if {$_usetix} {
  149.        lappend _insert_type_widgets \
  150.        *TixControl*entry *TixComboBox*Entry
  151.     }
  152.  
  153.    variable _select_type_widgets {*Checkbutton \
  154.        *Radiobutton \
  155.        *Menu}
  156.    variable _active_borderwidth_widgets {*Button *Radiobutton *Checkbutton}
  157.  
  158.    # Other Widgets that are given a borderwidth of $wm_default::borderwidth
  159.    variable _nonzero_borderwidth_widgets {}
  160.  
  161.    # Widgets that are given a borderwidth of 0
  162.    # must not be  *Entry
  163.    variable _null_borderwidth_widgets {*Menubutton *Label}
  164.  
  165.    variable _scrollbar_widgets {}
  166.    variable _scrollbar_widgets {*Scrollbar}
  167.    if {$_usetix} {
  168.        lappend  _scrollbar_widgets \
  169.            *TixTree*Scrollbar *TixDirTree*Scrollbar *TixDirList*Scrollbar \
  170.            *TixScrolledTList*Scrollbar *TixScrolledListBox*Scrollbar \
  171.            *TixScrolledHList*Scrollbar *TixMultiView*Scrollbar \
  172.            *TixScrolledText*Scrollbar *TixScrolledWindow*Scrollbar  \
  173.            *TixCObjView*Scrollbar
  174.    }
  175.  
  176.    proc debug {str} {
  177.        global tcl_platform
  178.  
  179.        if {[info commands "tix"] != "" && \
  180.            ([tix cget -debug] == "" || [tix cget -debug] == "0")} {return}
  181.  
  182.        switch -exact -- $tcl_platform(platform) windows {
  183.        if {[info commands console] != ""} {
  184.            console eval [list .console insert end "$str\n"]
  185.        }
  186.        } unix {
  187.        puts $str
  188.        }
  189.    }
  190.  
  191.     # Return the array of what we have deduced
  192.     proc getoptions {} {
  193.     set retval {}
  194.     set len [string length "::wm_default::"]
  195.         foreach variable [lsort [info vars ::wm_default::*]] {
  196.         if {[string match ::wm_default::_* $variable]} {continue}
  197.         set key [string range $variable $len end]
  198.         lappend retval $key [set $variable]
  199.     }
  200.     return $retval
  201.     }
  202.  
  203.     # Print out the array of what we have deduced
  204.     proc parray {} {
  205.     set retval ""
  206.         foreach {key val} [::wm_default::getoptions] {
  207.         append retval [join [list $key $val]] "\n"
  208.     }
  209.     debug $retval
  210.     return $retval
  211.     }
  212.  
  213.     # Pick a default borderwidth in pixels
  214.     set _bd 2
  215.     # Pick a default font size in pixels
  216.     set _screenheight [winfo screenheight .]
  217.     # Does anyone know what these should be for Unix and Windows?
  218.     if {$_screenheight < 500} {
  219.     # for 640x480
  220.     set _pixel 10
  221.     set _point 8
  222.     # Pick a default borderwidth which smaller
  223.     set _bd 1
  224.     } elseif {$_screenheight < 700} {
  225.     # for 800x600
  226.     set _pixel 12
  227.     set _point 8
  228.     } elseif {$_screenheight < 800} {
  229.     # for 1024x768
  230.     set _pixel 11
  231.     set _point 8
  232.     } elseif {$_screenheight < 1300} {
  233.     # for 1024x768
  234.     set _pixel 12
  235.     set _point 8
  236.     } else {
  237.     set _pixel 14
  238.     set _point 10
  239.     }
  240.  
  241.     # setup defaults depending on the OS and Window Manager
  242.     # Really should do another version for mono
  243.     switch -exact -- $tcl_platform(platform) windows {
  244.     # unfortunately CYGWIN is treated as windows
  245.     if {$tcl_platform(osVersion) < 5} {
  246.         set _prop_default "MS Sans Serif"
  247.     } else {
  248.         set _prop_default "Tahoma"
  249.     }
  250.  
  251.     # make sure this font is installed 
  252.     set _allowed [string tolow [font families]]
  253.     foreach font [list $_prop_default "MS Sans Serif" Tahoma Arial System] {
  254.         if {[lsearch -exact $_allowed [string tolow $font]] > -1} {
  255.         set _prop_default $font
  256.         break
  257.         }
  258.     }
  259.  
  260.     set _fixed_default {Courier New}
  261.     # make sure this font is installed 
  262.     foreach font [list $_fixed_default Courier System] {
  263.         if {[lsearch -exact $_allowed [string tolow $font]] > -1} {
  264.         set _fixed_default $font
  265.         break
  266.         }
  267.     }
  268.  
  269.     # Windows colors:
  270.     #    "3dDarkShadow",        COLOR_3DDKSHADOW,
  271.     #    "3dLight",            COLOR_3DLIGHT,
  272.     #    "ActiveBorder",        COLOR_ACTIVEBORDER,
  273.     #    "ActiveCaption",        COLOR_ACTIVECAPTION,
  274.     #    "AppWorkspace",        COLOR_APPWORKSPACE,
  275.     #    "Background",        COLOR_BACKGROUND,
  276.     #    "ButtonFace",        COLOR_BTNFACE,
  277.     #    "ButtonHighlight",        COLOR_BTNHIGHLIGHT,
  278.     #    "ButtonShadow",        COLOR_BTNSHADOW,
  279.     #    "ButtonText",        COLOR_BTNTEXT,
  280.     #    "CaptionText",        COLOR_CAPTIONTEXT,
  281.     #    "DisabledText",        COLOR_GRAYTEXT,
  282.     #    "GrayText",        COLOR_GRAYTEXT,
  283.     #    "Highlight",        COLOR_HIGHLIGHT,
  284.     #    "HighlightText",        COLOR_HIGHLIGHTTEXT,
  285.     #    "InactiveBorder",        COLOR_INACTIVEBORDER,
  286.     #    "InactiveCaption",        COLOR_INACTIVECAPTION,
  287.     #    "InactiveCaptionText",    COLOR_INACTIVECAPTIONTEXT,
  288.     #    "InfoBackground",        COLOR_INFOBK,
  289.     #    "InfoText",            COLOR_INFOTEXT,
  290.     #    "Menu",            COLOR_MENU,
  291.     #    "MenuText",            COLOR_MENUTEXT,
  292.     #    "Scrollbar",        COLOR_SCROLLBAR,
  293.     #    "Window",            COLOR_WINDOW,
  294.     #    "WindowFrame",        COLOR_WINDOWFRAME,
  295.     #    "WindowText",        COLOR_WINDOWTEXT,
  296.     
  297.     variable \
  298.         background           "SystemButtonFace" \
  299.         foreground           "SystemButtonText" \
  300.         disabledforeground      "SystemDisabledText" \
  301.         disabledbackground      "SystemButtonShadow" \
  302.         textfamily             $_prop_default \
  303.         systemfamily           $_prop_default \
  304.         menufamily               $_prop_default \
  305.         fixedfamily           $_fixed_default \
  306.         fontsize              $_point \
  307.         textbackground       "SystemWindow" \
  308.         textforeground       "SystemWindowText" \
  309.         disabledtextbackground  "SystemDisabledText" \
  310.         selectbackground     "SystemHighlight" \
  311.         selectforeground     "SystemHighlightText" \
  312.         selectcolor          "SystemWindow" \
  313.         highlightcolor      "SystemWindowFrame" \
  314.         highlightbackground     "SystemButtonFace" \
  315.         scrollbars        "SystemScrollbar" \
  316.         borderwidth          $_bd \
  317.         menubackground        "SystemMenu" \
  318.         menuforeground        "SystemMenuText"
  319.  
  320.     variable highlightthickness             1
  321.  
  322.     # Windows does not have an activebackground, but Tk does
  323.     variable activebackground $background
  324.     variable activeforeground $foreground
  325.     } default {
  326.     # intended for Unix
  327.  
  328.     # Tk uses the following defaults:
  329.  
  330.     #define NORMAL_BG    "#d9d9d9"
  331.     #define ACTIVE_BG    "#ececec"
  332.     #define SELECT_BG    "#c3c3c3"
  333.     #define TROUGH        "#c3c3c3"
  334.     #define INDICATOR    "#b03060"
  335.     #define DISABLED    "#a3a3a3"
  336.  
  337.     # We know . exists and it has a background
  338.     # This should be "#d9d9d9" under default Tk
  339.     set _bg [. cget -background]
  340.  
  341.     set _prop_default helvetica
  342.     # make sure this font is installed 
  343.     set _allowed [string tolow [font families]]
  344.     foreach font [list $_prop_default times fixed] {
  345.         if {[lsearch -exact $_allowed [string tolow $font]] > -1} {
  346.         set _prop_default $font
  347.         break
  348.         }
  349.     }
  350.     set _fixed_default courier
  351.     # make sure this font is installed 
  352.     foreach font [list $_fixed_default fixed] {
  353.         if {[lsearch -exact $_allowed [string tolow $font]] > -1} {
  354.         set _fixed_default $font
  355.         break
  356.         }
  357.     }
  358.  
  359.     variable \
  360.         background           $_bg \
  361.         foreground           Black \
  362.         disabledforeground      #808080 \
  363.         disabledbackground      #a3a3a3 \
  364.         textfamily         $_prop_default \
  365.         systemfamily           $_prop_default \
  366.         menufamily           $_prop_default \
  367.         fixedfamily           $_fixed_default \
  368.         fontsize        $_pixel \
  369.         textbackground       white \
  370.         textforeground       Black \
  371.         disabledtextbackground  $_bg \
  372.         selectbackground     #000080 \
  373.         selectforeground     white \
  374.         selectcolor          yellow \
  375.         highlightcolor      Black \
  376.         highlightbackground     $_bg \
  377.         scrollbars        "#c3c3c3" \
  378.         borderwidth          $_bd \
  379.         menubackground           $_bg \
  380.         menuforeground           Black
  381.  
  382.     variable highlightthickness             1
  383.  
  384.     # Windows does not have an activebackground, but Tk does
  385.     variable activebackground "#ececec"
  386.     variable activeforeground $foreground
  387.    }
  388.  
  389.    # priority should be userDefault?
  390.    if {$_usetix} {
  391.        variable priority             [tix cget -schemepriority]
  392.    } else {
  393.        variable priority             75
  394.    }
  395.  
  396.    # variables that will be derived during addoptions - set to null for now
  397.    variable system_font {}
  398.    variable menu_font  {}
  399.    variable fixed_font {}
  400.    variable text_font  {}
  401.  
  402.    # Different desktops have different visible regions
  403.    # This is not working properly yet.
  404.    variable \
  405.        geometry 0+0+[winfo screenwidth .]+$_screenheight
  406.  
  407.    # Different desktops have different focusmodels: clicktofocus or followsmouse
  408.    # This is not working properly yet
  409.    variable focusmodel clicktofocus
  410.  
  411.    # Some desktops have standardized link colors
  412.    # This is not working properly yet
  413.    variable linkcolor "#0000ff" vlinkcolor "#800000" alinkcolor "#800080"
  414.  
  415.    proc default {args} {
  416.     # Override the defaults with any optional arguments
  417.     foreach {var val} $args {
  418.         set $var $val
  419.     }
  420.     }
  421.  
  422.     proc setup {{type ""}} {
  423.     # type is one of the recognized window managers
  424.     # one of: cde kde win
  425.     global tcl_platform env
  426.  
  427.     if {$type == ""} {
  428.         if {[set type [::tixDetermineWM]] == ""} {
  429.         set ::wm_default::wm ""
  430.         # Generic unix
  431.         return
  432.         }
  433.     }
  434.     setup-$type
  435.     set ::wm_default::wm $type
  436.     # todo - make the menubutton enter and leave events more compatible
  437.     }
  438.  
  439.     proc setup-windows {args} {
  440.     # Already done by Tk above.
  441.     # Should find out the useable window region
  442.     }
  443.  
  444.     proc setup-gnome {args} {
  445.     # GNOME is still barely supported because of the difficulty
  446.     # of finding and parsing sawfish definition files.
  447.     # First you have to find what window manager, then what theme,
  448.     # then find the files, then parse them according to each Wm's syntax.
  449.     global env
  450.  
  451.     set bg $wm_default::background
  452.     set fg $wm_default::foreground
  453.     set txtFont $wm_default::textfamily
  454.     set btnFont $wm_default::systemfamily
  455.  
  456.     debug "Setting up Gnome environment"
  457.  
  458.     set file ~/.gnome/theme-switcher-capplet
  459.     if {![file exists $file] || \
  460.         [catch {open $file} fd] || $fd == ""} {
  461.         debug "Skipping $file"
  462.     } else {
  463.         debug "Reading $file"
  464.         set contents [read $fd]
  465.         catch {close $fd}
  466.     
  467.         if {![regexp -- "use_theme_font=true" $contents]} {
  468.         # not activated
  469.         } elseif {[regexp -- "\nfont=(\[-a-zA-Z0-9,\]+)" $contents \
  470.             foo font]} {
  471.         set_unix_font $font
  472.         
  473.         }
  474.     }
  475.  
  476.     }
  477.  
  478.     proc set_unix_font {font} {
  479.  
  480.     set list [split $font "-"]
  481.     set font [lindex $list 2]
  482.     set font [string tolow $font]
  483.     if {$font != "" && [lsearch -exact [font families] $font] > -1} {
  484.         set ::wm_default::textfamily $font
  485.         debug "Setting textfamily to $font"
  486.         set ::wm_default::systemfamily $font
  487.         set ::wm_default::menufamily $font
  488.     } else {
  489.         debug "Unable to set font: '$list'"
  490.     }
  491.     
  492.     if {[set size [lindex $list 7]] != "" && \
  493.         [string is int $size]} {
  494.         debug "Setting fontsize to '$size'"
  495.         set ::wm_default::fontsize $size
  496.     } elseif {[set size [lindex $list 8]] != "" && \
  497.         [string is int $size]} {
  498.         if {$size > 100} {set size [expr $size / 10]}
  499.         debug "Setting fontsize to '$size'"
  500.         set ::wm_default::fontsize $size
  501.     } else {
  502.         debug "Unable to set fontsize: '$list'"
  503.     }
  504.     }
  505.  
  506.     # Common to KDE1 and KDE2
  507.     proc setup-kde {args} {
  508.     global env
  509.  
  510.     set file ~/.kderc
  511.     if {![file exists $file] || \
  512.         [catch {open $file} fd] || $fd == ""} {
  513.         debug "Skipping $file"
  514.     } else {
  515.         debug "Reading $file"
  516.         set contents [read $fd]
  517.         catch {close $fd}
  518.     
  519.         if {[regexp -- "\nfixedfamily=(\[-a-zA-Z0-9,\]+)" $contents \
  520.             foo font]} {
  521.         set list [split $font ","]
  522.         set font [lindex $list 0]
  523.         set ::wm_default::fixedfamily $font
  524.         debug "Setting fixedfamily to $font"
  525.         }
  526.         if {[regexp -- "\nfont=(\[-a-zA-Z0-9,\]+)" $contents \
  527.             foo font]} {
  528.         set list [split $font ","]
  529.         set font [lindex $list 0]
  530.         set ::wm_default::textfamily $font
  531.         debug "Setting textfamily to $font"
  532.         set ::wm_default::systemfamily $font
  533.         set ::wm_default::menufamily $font
  534.         }
  535.     }
  536.  
  537.     }
  538.  
  539.     proc setup-kde1 {args} {
  540.     # Shortcut for the moment
  541.     return [eval setup-kde $args]
  542.     }
  543.  
  544.     proc set-kde2-color {str contents var} {
  545.     if {[regexp -- "\n${str}=(\[0-9,\]+)" $contents \
  546.         foo color]} {
  547.         set color [eval format "#%02x%02x%02x" [split $color ","]]
  548.         set ::wm_default::$var $color
  549.         debug "setting $var to $color"
  550.     }
  551.     }
  552.  
  553.     proc setup-kde2 {args} {
  554.     global env
  555.  
  556.     set bg $wm_default::background
  557.     set fg $wm_default::foreground
  558.     set txtFont $wm_default::textfamily
  559.     set btnFont $wm_default::systemfamily
  560.  
  561.     debug "Setting up KDE environment"
  562.  
  563.     # Look for system the user settings
  564.     set dirs [list ~/.kde ~/.kde2]
  565.     if {[info exists env(KDEDIR)] && [file isdir $env(KDEDIR)]} {
  566.         lappend dirs $env(KDEDIR)
  567.     }
  568.     # read them sequentially and overwrite the previous values
  569.     foreach dir $dirs {
  570.  
  571.         set file $dir/share/config/kdeglobals
  572.         if {![file exists $file] || \
  573.             [catch {open $file} fd] || $fd == ""} {
  574.         debug "Skipping $file"
  575.         } else {
  576.         debug "Reading $file"
  577.         set contents [read $fd]
  578.         catch {close $fd}
  579.         set-kde2-color background $contents background
  580.         if {[regexp -- "\nselectBackground=(\[0-9,\]+)" $contents \
  581.             foo color]} {
  582.             set color [eval format "#%02x%02x%02x" [split $color ","]]
  583.             set ::wm_default::selectbackground $color
  584.             debug "setting selectbackground to $color"
  585.         }
  586.         if {[regexp -- "\nselectForeground=(\[0-9,\]+)" $contents \
  587.             foo color]} {
  588.             set color [eval format "#%02x%02x%02x" [split $color ","]]
  589.             set ::wm_default::selectforeground $color
  590.             debug "setting selectforeground to $color"
  591.         }
  592.         if {[regexp -- "\nforeground=(\[0-9,\]+)" $contents \
  593.             foo color]} {
  594.             set color [eval format "#%02x%02x%02x" [split $color ","]]
  595.             set ::wm_default::foreground $color
  596.             debug "setting foreground to $color"
  597.         }
  598.         if {[regexp -- "\nbackground=(\[0-9,\]+)" $contents \
  599.             foo color]} {
  600.             set color [eval format "#%02x%02x%02x" [split $color ","]]
  601.             set ::wm_default::background $color
  602.             debug "setting background to $color"
  603.         }
  604.         if {[regexp -- "\nwindowBackground=(\[0-9,\]+)" $contents \
  605.             foo color]} {
  606.             set color [eval format "#%02x%02x%02x" [split $color ","]]
  607.             set ::wm_default::textbackground $color
  608.             debug "setting textbackground to $color"
  609.         }
  610.         if {[regexp -- "\nvisitedLinkColor=(\[0-9,\]+)" $contents \
  611.             foo color]} {
  612.             set color [eval format "#%02x%02x%02x" [split $color ","]]
  613.             set ::wm_default::vlinkcolor $color
  614.             debug "setting vlinkcolor to $color"
  615.         }
  616.         if {[regexp -- "\nlinkColor=(\[0-9,\]+)" $contents \
  617.             foo color]} {
  618.             set color [eval format "#%02x%02x%02x" [split $color ","]]
  619.             set ::wm_default::linkcolor $color
  620.             debug "setting linkcolor to $color"
  621.         }
  622.         if {[regexp -- "\nactiveFont=(\[-a-zA-Z0-9,\]+)" $contents \
  623.             foo font]} {
  624.             set list [split $font ","]
  625.             set font [lindex $list 0]
  626.             set ::wm_default::textfamily $font
  627.             set size [lindex $list 1]
  628.             if {$size != "" && [string is integer $size]} {
  629.             set ::wm_default::fontsize $size
  630.             }
  631.             debug "Setting textfamily to $font"
  632.             set ::wm_default::systemfamily $font
  633.             set ::wm_default::menufamily $font
  634.         }
  635.         }
  636.  
  637.         # should pick up visitedLinkColor
  638.  
  639.         set file $dir/share/config/kwmrc
  640.         if {![file exists $file] || \
  641.             [catch {open $file} fd] || $fd == ""} {
  642.         debug "Skipping $file"
  643.         } else {
  644.         debug "Reading $file"
  645.         set contents [read $fd]
  646.         catch {close $fd}
  647.         if {[regexp -- "\nDesktop1Region=(\[0-9+\]+)" $contents \
  648.             foo region]} {
  649.             set ::wm_default::geometry $region
  650.             debug "Setting geometry to $region"
  651.         }
  652.  
  653.         if {[regexp -- "\nFocusPolicy=ClickToFocus" $contents \
  654.             foo region]} {
  655.             set ::wm_default::focusmodel clicktofocus
  656.             debug "Setting focusmodel to clicktofocus"
  657.         } else {
  658.             # followsmouse
  659.         }
  660.         }
  661.     }
  662.  
  663.     return [eval setup-kde $args]
  664.     }
  665.  
  666.     proc setup-cde {args} {
  667.     namespace import wm_default::*
  668.  
  669.     set bg $wm_default::background
  670.     set fg $wm_default::foreground
  671.     set txtFont $wm_default::textfamily
  672.     set sysFont $wm_default::systemfamily
  673.  
  674.     debug "Setting up CDE environment"
  675.  
  676.         # if any of these options are missing, we must not be under CDE
  677.     set txtFont [option get . textfamilyList textfamilyList]
  678.     set sysFont [option get . systemfamilyList systemfamilyList]
  679.         if {[string length $txtFont] > 0 && [string length $sysFont] > 0} {
  680.         set txtFont [lindex [split $txtFont :] 0]
  681.         set sysFont [lindex [split $sysFont :] 0]
  682.         if {$txtFont != ""} {set textfamily $txtFont}
  683.         if {$sysFont != ""} {set systemfamily $sysFont}
  684.         #
  685.         # If we can find the user's dt.resources file, we can find out the
  686.         # palette and text background/foreground colors
  687.         #
  688.         set txtBg $bg
  689.         set txtFg $fg
  690.         set selFg  $selectforeground
  691.         set selBg  $selectbackground
  692.         set selCol $selectcolor
  693.         set fh ""
  694.         set palf ""
  695.         set cur_rsrc ~/.dt/sessions/current/dt.resources
  696.         set hom_rsrc ~/.dt/sessions/home/dt.resources
  697.         if {[file readable $cur_rsrc] && [file readable $hom_rsrc]} {
  698.         if {[file mtime $cur_rsrc] > [file mtime $hom_rsrc]} {
  699.             if {[catch {open $cur_rsrc r} fh]} {set fh ""}
  700.         } else {
  701.             if {[catch {open $hom_rsrc r} fh]} {set fh ""}
  702.         }
  703.         } elseif {[file readable $cur_rsrc]} {
  704.         if {[catch {open $cur_rsrc r} fh]} {set fh ""}
  705.         } elseif {[file readable $hom_rsrc]} {
  706.         if {[catch {open $hom_rsrc r} fh]} {set fh ""}
  707.         }
  708.         if {[string length $fh] > 0} {
  709.         while {[gets $fh ln] != -1} {
  710.             regexp -- "^\\*0\\*ColorPalette:\[ \t]*(.*)\$" $ln nil palf
  711.             regexp -- "^Window.Color.Background:\[ \t]*(.*)\$" $ln nil txtBg
  712.             regexp -- "^Window.Color.Foreground:\[ \t]*(.*)\$" $ln nil txtFg
  713.         }
  714.         catch {close $fh}
  715.         if {[string compare $txtBg $bg] != 0} {
  716.             set selBg $txtFg
  717.             set selFg $txtBg
  718.         }
  719.         }
  720.         #
  721.         # If the *0*ColorPalette setting was found above, try to find the
  722.         # indicated file in ~/.dt, $DTHOME, or /usr/dt.  The 3rd line in the
  723.         # file will be the radiobutton/checkbutton selectColor.
  724.         #
  725.         if {[string length $palf]} {
  726.         set dtdir /usr/dt
  727.         if [info exists env(DTHOME)] {
  728.             set dtdir $env(DTHOME)
  729.         }
  730.         if {[file readable ~/.dt/palettes/$palf]} {
  731.             set palf ~/.dt/palettes/$palf
  732.         } elseif {[file readable $dtdir/palettes/$palf]} {
  733.             set palf $dtdir/palettes/$palf
  734.         } else {
  735.             set palf ""
  736.         }
  737.         if {[string length $palf]} {
  738.             if {![catch {open $palf r} fh]} {
  739.             # selectColor will be the 3rd line in the file --
  740.             set ln ""; catch {gets $fh; gets $fh; gets $fh ln}
  741.             set ln [string trim $ln]
  742.             if {[string length $ln]} {set selCol $ln}
  743.             close $fh
  744.             }
  745.         }
  746.         }
  747.         set ::wm_default::background $bg
  748.         set ::wm_default::foreground $fg
  749.         set ::wm_default::textfamily $txtFont
  750.         set ::wm_default::systemfamily $sysFont
  751.         set ::wm_default::menufamily $sysFont
  752.         set ::wm_default::textbackground $txtBg
  753.         set ::wm_default::textforeground $txtFg
  754.         set ::wm_default::selectbackground $selBg
  755.         set ::wm_default::selectforeground $selFg
  756.         set ::wm_default::selectcolor $selCol
  757.     }
  758.     }
  759.  
  760.     proc derivefonts {} {
  761.     global tcl_platform env
  762.  
  763.     # variables that will be derived
  764.     variable system_font 
  765.     variable menu_font 
  766.     variable fixed_font 
  767.     variable text_font 
  768.  
  769.     # This should be a variable
  770.     set size $::wm_default::fontsize
  771.  
  772.         #
  773.         # Set default fonts 
  774.         #
  775.  
  776.     global tcl_platform env
  777.     switch -exact -- $tcl_platform(platform) windows {
  778.         
  779.         if {$size == "" || ![string is integer $size]} {
  780.         debug "Internal error - fontsize not set"
  781.         set size 8 ; # pixel
  782.         }
  783.  
  784.         set system_font [list $::wm_default::systemfamily $size]
  785.         set menu_font [list $::wm_default::menufamily $size]
  786.         set text_font [list $::wm_default::textfamily $size]
  787.         set fixed_font [list $::wm_default::fixedfamily $size]
  788.     } default {
  789.         if {$size == "" || ![string is integer $size]} {
  790.         puts stderr "Internal error - fontsize not set"
  791.         set size 10 ; # pixel
  792.         }
  793.  
  794.         set system_font [list $::wm_default::systemfamily -$size]
  795.         if {[set type $::wm_default::wm] == ""} {
  796.         # Generic unix
  797.         # some Unix Wms seem to make Menu fonts bold - ugly IMHO
  798.         set menu_font [list $::wm_default::menufamily -$size bold]
  799.         } else {
  800.         # gnome kde1 kde2 cde kde don't
  801.         set menu_font [list $::wm_default::menufamily -$size]
  802.         }
  803.         set text_font [list $::wm_default::textfamily -$size]
  804.         set fixed_font [list $::wm_default::fixedfamily -$size]
  805.     }
  806.     }
  807.  
  808.     proc addoptions {args} {
  809.     global tcl_platform env tix_version
  810.  
  811.     # variables that will be derived
  812.     variable system_font 
  813.     variable menu_font 
  814.     variable fixed_font 
  815.     variable text_font 
  816.  
  817.     if {[info commands "tix"] != ""} {set _usetix 1} {set _usetix 0}
  818.  
  819.     # Override what you have found with any optional arguments
  820.     foreach {var val} $args {
  821.         set var [string trimleft $var "-"]
  822.         set ::wm_default::$var $val
  823.     }
  824.  
  825.     set pri $::wm_default::priority
  826.     # If you are running under Tix, set the colorscheme now
  827.     # The options below will then override the Tix settings
  828.     if {$_usetix} {
  829.     
  830.         # Tix's focus model is very non-standard
  831.         bind TixComboBox <FocusIn> ""
  832.         bind TixComboBox <FocusOut> ""
  833.  
  834.         if {$tix_version < "8.2"} {
  835.         # works??
  836.         option add *TixNoteBook.nbframe.inactiveBackground \
  837.             $::wm_default::disabledbackground $pri
  838.         } else {
  839.         # works??
  840.         option add *TixNoteBook.nbframe.inactiveBackground \
  841.             $::wm_default::background $pri
  842.         }
  843.  
  844.         # works??
  845.         option add *TixPanedWindow.seperatorBg \
  846.             $::wm_default::disabledbackground $pri
  847.         option add *TixPanedWindow.handleBg      \
  848.             $::wm_default::disabledbackground $pri
  849.  
  850.         # works??
  851.         option add *TixPanedWindow.separatorActiveBg \
  852.             $::wm_default::activebackground $pri
  853.         option add *TixPanedWindow.handleActiveBg      \
  854.             $::wm_default::activebackground $pri
  855.         option add *TixPanedWindow.Background      \
  856.             $::wm_default::disabledbackground $pri
  857.  
  858.         # works??
  859.         option add *TixResizeHandle*background \
  860.             $::wm_default::disabledbackground $pri
  861.  
  862.     }
  863.         foreach pref $wm_default::_frame_widgets {
  864.             option add $pref.background $::wm_default::background $pri
  865.         }
  866.     option add *Background $::wm_default::background $pri
  867.  
  868.     derivefonts
  869.  
  870.     # Set the global defaults to the system font
  871.         foreach pref [list *Font *font] {
  872.             option add $pref $system_font $pri
  873.         }
  874.  
  875.     # Set the "system" type defaults to the system font
  876.         foreach pref $wm_default::_menu_font_widgets {
  877.             option add $pref.font $menu_font $pri
  878.         }
  879.         foreach pref $wm_default::_button_font_widgets {
  880.             option add $pref.font $system_font $pri
  881.             option add $pref.disabledForeground $::wm_default::disabledforeground $pri
  882.             option add $pref.background $::wm_default::background $pri
  883.             option add $pref.foreground $::wm_default::foreground $pri
  884.         option add $pref.highlightBackground $::wm_default::highlightbackground $pri
  885.         }
  886.         foreach pref $wm_default::_system_font_widgets {
  887.             option add $pref.font $system_font $pri
  888.             option add $pref.background $::wm_default::background $pri
  889.             option add $pref.foreground $::wm_default::foreground $pri
  890.         option add $pref.highlightBackground $::wm_default::highlightbackground $pri
  891.         }
  892.  
  893.         foreach pref $wm_default::_text_type_widgets {
  894.             option add $pref.font $text_font $pri
  895.             option add $pref.relief sunken $pri
  896.             option add $pref.borderWidth $::wm_default::borderwidth $pri
  897.  
  898.             option add $pref.background $::wm_default::textbackground $pri
  899.             option add $pref.foreground $::wm_default::textforeground $pri
  900.             option add $pref.selectBackground $::wm_default::selectbackground $pri
  901.             option add $pref.selectForeground $::wm_default::selectforeground $pri
  902.             option add $pref.highlightThickness $::wm_default::highlightthickness $pri
  903.             option add $pref.disabledBackground $::wm_default::disabledtextbackground $pri
  904.         }
  905.         foreach pref $wm_default::_insert_type_widgets {
  906.             option add $pref.relief sunken $pri
  907.             option add $pref.insertBackground $::wm_default::textforeground $pri
  908.             option add $pref.highlightThickness $::wm_default::highlightthickness $pri
  909.         }
  910.         #
  911.         # Set the Selector color for radiobuttons, checkbuttons, et. al
  912.         #
  913.         foreach pref $wm_default::_select_type_widgets {
  914.             option add $pref.selectColor $::wm_default::selectcolor $pri
  915.             option add $pref.background $::wm_default::background $pri
  916.             option add $pref.foreground $::wm_default::foreground $pri
  917.  
  918.         option add $pref.activeBackground $::wm_default::activebackground $pri
  919.             option add $pref.activeForeground $::wm_default::activeforeground $pri
  920.         }
  921.  
  922.     # Set the "active" defaults - this could be controversial
  923.         foreach pref $wm_default::_menu_font_widgets {
  924.         option add $pref.activeBackground $::wm_default::activebackground $pri
  925.             option add $pref.activeForeground $::wm_default::activeforeground $pri
  926.             option add $pref.background $::wm_default::background $pri
  927.             option add $pref.foreground $::wm_default::foreground $pri
  928.             option add $pref.disabledForeground $::wm_default::disabledforeground $pri
  929.             option add $pref.highlightThickness $::wm_default::highlightthickness $pri
  930.         }
  931.  
  932.     switch -exact -- $tcl_platform(platform) windows {
  933.         # Make sure this is set to foreground - check marks on menus
  934.         set _menu_select_color $::wm_default::foreground
  935.     } default {
  936.         # On unix there are recessed check boxes not check marks
  937.         set _menu_select_color $::wm_default::selectcolor
  938.     }
  939.     option add *Menu.selectColor $_menu_select_color $pri
  940.     if {$_usetix} {
  941.         option add *TixMenu.selectColor $_menu_select_color $pri
  942.             option add *TixBalloon*message.background $::wm_default::textbackground $pri
  943.         
  944.     }
  945.  
  946.     # Windows does not have an activebackground, but Tk does
  947.         foreach pref $wm_default::_button_font_widgets {
  948.             option add $pref.activeBackground $::wm_default::activebackground $pri
  949.             option add $pref.activeForeground $::wm_default::activeforeground $pri
  950.         }
  951.  
  952.         #
  953.         # Set the default *button borderwidth
  954.         #
  955.     # option add *.borderWidth $::wm_default::borderwidth $pri
  956.  
  957.         foreach pref $wm_default::_active_borderwidth_widgets {
  958.             option add $pref.activeBorderWidth $::wm_default::borderwidth $pri
  959.             option add $pref.borderWidth $::wm_default::borderwidth $pri
  960.         }
  961.         foreach pref $wm_default::_nonzero_borderwidth_widgets {
  962.             option add $pref.borderWidth $::wm_default::borderwidth $pri
  963.         }
  964.         foreach pref $wm_default::_null_borderwidth_widgets {
  965.             option add $pref.borderWidth 0 $pri
  966.         }
  967.  
  968.     if {$_usetix} {
  969.         if {$tix_version < "8.2"} {
  970.         option add *TixNoteBook.nbframe.inactiveBackground \
  971.             $::wm_default::disabledbackground $pri
  972.         option add *TixNoteBook*nbframe.inactiveBackground \
  973.             $::wm_default::disabledbackground $pri
  974.         } else {
  975.         option add *TixNoteBook.nbframe.inactiveBackground \
  976.             $::wm_default::background $pri
  977.         option add *TixNoteBook*nbframe.inactiveBackground \
  978.             $::wm_default::background $pri
  979.         }
  980.     }
  981.  
  982.         foreach pref $wm_default::_scrollbar_widgets {
  983.             option add $pref.background $::wm_default::background $pri
  984.         option add $pref.foreground $::wm_default::foreground $pri
  985.         # Tix 8.1.1 had these wrong
  986.         option add $pref.troughColor $::wm_default::scrollbars $pri
  987.         option add $pref.borderWidth $::wm_default::borderwidth $pri
  988.     }
  989.     option add *Scale.borderWidth $::wm_default::borderwidth $pri
  990.     option add *Scale.troughColor $::wm_default::scrollbars $pri
  991.  
  992.     option add *highlightColor $::wm_default::highlightcolor $pri
  993.     option add *highlightBackground $::wm_default::highlightbackground $pri
  994.     option add *HighlightBackground $::wm_default::highlightbackground $pri
  995.  
  996.     # not _system_font_widgets
  997.     set _focus_widgets [concat \
  998.         $::wm_default::_frame_widgets \
  999.         $::wm_default::_menu_font_widgets \
  1000.         $::wm_default::_text_type_widgets \
  1001.         $::wm_default::_insert_type_widgets \
  1002.         $::wm_default::_select_type_widgets \
  1003.         $::wm_default::_active_borderwidth_widgets \
  1004.         $::wm_default::_nonzero_borderwidth_widgets \
  1005.         $::wm_default::_null_borderwidth_widgets ]
  1006.  
  1007.     if {$_usetix} {
  1008.         set _tix_hl_widgets [list *TixBitmapButton*label \
  1009.             *TixComboBox*Entry \
  1010.             *TixControl*entry \
  1011.             *TixDirList*hlist \
  1012.             *TixDirTree*hlist \
  1013.             *TixFileEntry*Entry \
  1014.             *TixFileEntry*entry \
  1015.             *TixMultiList*Listbox \
  1016.             *TixNoteBook.nbframe \
  1017.             *TixOptionMenu*menubutton \
  1018.             *TixScrolledHList*hlist \
  1019.             *TixScrolledListBox*listbox\
  1020.             *TixScrolledTList*tlist \
  1021.             *TixTree*hlist]
  1022.         eval lappend _focus_widgets $_tix_hl_widgets
  1023.     }
  1024.  
  1025.     foreach pref [lsort -uniq $_focus_widgets] {
  1026.         option add $pref.highlightBackground $::wm_default::highlightbackground $pri
  1027.     }
  1028.  
  1029.     # Now for some things to make it look more like the WM
  1030.  
  1031.     # todo - look for and call
  1032.     if {$::wm_default::focusmodel == "followsmouse"} {
  1033.         tk_focusFollowsMouse
  1034.     }
  1035.  
  1036.     if {$_usetix} {
  1037.         tixSetDefaultOptions
  1038.  
  1039.         if {[lsearch -exact {windows kde1 kde2} $::wm_default::wm] > -1} {
  1040.         # Fix the way Button boxes are packed
  1041.         if {[info procs ::tixButtonBox:add] == ""} {
  1042.             uplevel #0 auto_load tixButtonBox
  1043.         }
  1044.         proc ::tixButtonBox:add {w name args} {
  1045.             upvar #0 $w data
  1046.             eval button $w.$name $args
  1047.         
  1048.             if {![info exists data(-padx)]} {set data(-padx) 5}
  1049.             if {![info exists data(-pady)]} {set data(-pady) 10}
  1050.         
  1051.             if {$data(-orientation) == "horizontal"} {
  1052.             # Push the Buttons  to the right
  1053.             if {[info commands $w.pad] == ""} {
  1054.                 label $w.pad
  1055.                 pack $w.pad -side left -expand yes -fill both
  1056.             }
  1057.             pack $w.$name -side left \
  1058.                 -expand no \
  1059.                 -padx $data(-padx) -pady $data(-pady)
  1060.             } else {
  1061.             pack $w.$name -side top \
  1062.                 -expand no -fill x \
  1063.                 -padx $data(-padx) -pady $data(-pady)
  1064.             }
  1065.             lappend data(g:buttons) $name
  1066.             set data(w:$name) $w.$name
  1067.             return $w.$name
  1068.         }
  1069.         option add *TixButtonBox.relief flat $::wm_default::priority
  1070.         option add *TixButtonBox.borderwidth 2 $::wm_default::priority
  1071.         }
  1072.     }
  1073.     return [getoptions]
  1074.     }
  1075.  
  1076.     namespace export setup addoptions getoptions parray
  1077. }
  1078.  
  1079. package provide wm_default 1.0
  1080.  
  1081.  
  1082. proc tixSetDefaultOptions {} {
  1083.     # Returns one of cde kde1 kde2 gnome windows or ""
  1084.     global tcl_platform env tixOption
  1085.  
  1086.     # There is no overlap between the wm_default variable names and
  1087.     # the old style tixOption names. So we can add the wm_default variable
  1088.     # names to the array tixOption, and allow people to upgrade in time.
  1089.  
  1090.     foreach variable {
  1091.     wm
  1092.     linkcolor
  1093.     vlinkcolor
  1094.     alinkcolor
  1095.     background
  1096.     foreground
  1097.     disabledforeground
  1098.     disabledbackground
  1099.     textfamily    
  1100.     systemfamily
  1101.     menufamily     
  1102.     fixedfamily
  1103.     fontsize    
  1104.     textbackground
  1105.     textforeground
  1106.     disabledtextbackground
  1107.     selectbackground
  1108.     selectforeground
  1109.     selectcolor
  1110.     highlightcolor
  1111.     highlightbackground
  1112.     scrollbars
  1113.     borderwidth
  1114.     priority
  1115.     menubackground
  1116.     menuforeground
  1117.     activebackground
  1118.     activeforeground
  1119.     system_font 
  1120.     menu_font 
  1121.     fixed_font 
  1122.     text_font 
  1123.     } {
  1124.     set tixOption($variable) [set ::wm_default::$variable]
  1125.     }
  1126.  
  1127. }
  1128.